home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tvdmx.exe / DMXGIZMA.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-16  |  14KB  |  504 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    DMXGIZMA  --constants, variables and functions    }
  5. {    tvDMX     --data editing project (ver 1.5)    }
  6. {                            }
  7. {    Copyright (c) 1992  Randolph Beck        }
  8. {                P.O. Box  56-0487        }
  9. {                Orlando, FL 32856        }
  10. {                CIS:  72361,753        }
  11. {                            }
  12. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  13.  
  14. Unit DMXGIZMA;
  15.  
  16. {$V-,X+,O+,D-,B-,R- }
  17.  
  18. interface
  19.  
  20. uses  Objects, Drivers, Views, App, RSet;
  21.  
  22. {$DEFINE tvDMX1A }
  23.  
  24. const
  25.     cmDMX               = 4400;
  26.  
  27.     cmDMX_RollCall      = cmDMX +  1;
  28.     cmDMX_Ack           = cmDMX +  2;
  29.     cmDMX_Enter         = cmDMX +  3;
  30.     cmDMX_FieldAltered  = cmDMX +  4;
  31.     cmDMX_Draw          = cmDMX +  5;
  32.     cmDMX_DrawData      = cmDMX +  6;
  33.     cmDMX_Lock          = cmDMX +  7;
  34.     cmDMX_LockData      = cmDMX +  8;
  35.     cmDMX_Unlock        = cmDMX +  9;
  36.     cmDMX_UnlockData    = cmDMX + 10;
  37.     cmDMX_FixSize       = cmDMX + 11;
  38.     cmDMX_ZeroizeRec    = cmDMX + 12;
  39.     cmDMX_WrongKey    = cmDMX + 13;
  40.  
  41.     cmDMX_Left          = cmDMX + 15;
  42.     cmDMX_Right         = cmDMX + 16;
  43.  
  44.     cmDMX_Home          = cmDMX + 18;
  45.     cmDMX_End           = cmDMX + 19;
  46.  
  47.     cmDMX_goto          = cmDMX + 20;
  48.  
  49.     cmDMX_NextRow       = cmDMX + 21;
  50.     cmDMX_Up            = cmDMX + 22;
  51.     cmDMX_Down          = cmDMX + 23;
  52.     cmDMX_PgUp          = cmDMX + 24;
  53.     cmDMX_PgDn          = cmDMX + 25;
  54.     cmDMX_ScreenTop     = cmDMX + 26;
  55.     cmDMX_ScreenBottom  = cmDMX + 27;
  56.     cmDMX_Top           = cmDMX + 28;
  57.     cmDMX_Bottom        = cmDMX + 29;
  58.  
  59.  
  60.             {  +------------ 1 normal fields             }
  61.             {  | +---------- 2 normal selected field     }
  62.             {  | | +-------- 3 read-only selected field  }
  63.             {  | | | +------ 4 locked field              }
  64.             {  | | | | +---- 5 delimiter                 }
  65.             {  | | | | | +-- 6 border                    }
  66.             {  | | | | | |  }
  67.     cDMX  : string [6]  = #6#7#5#5#1#2;
  68.  
  69.  
  70.     accNormal    =    0;
  71.     accReadOnly  =    1;
  72.     accHidden    =    2;
  73.     accSkip      =    4;
  74.     accDelimiter =    8;
  75.  
  76.  
  77.     showTRUE     =   '■';  { TRUE indicator  }
  78.     showFALSE    =   ' ';  { FALSE indicator }
  79.     showOVERFLOW =   '*';  { overflow indicator for numbers }
  80.  
  81.  
  82.     fldSTR       =   'S';  { string field }
  83.     fldSTRNUM    =   '#';  { numeric string field }
  84.     fldCHAR      =   'C';  { character field }
  85.     fldCHARNUM   =   '0';  { numeric character field }
  86.     fldCHARVAL   =   'N';  { dbase formatted numeric field }
  87.     fldBYTE      =   'B';  { byte field }
  88.     fldSHORTINT  =   'J';  { shortint field }
  89.     fldWORD      =   'W';  { word field }
  90.     fldINTEGER   =   'I';  { integer field }
  91.     fldLONGINT   =   'L';  { longint field }
  92.     fldREALNUM   =   'R';  { real number field  (uses TREALNUM) }
  93.     fldBOOLEAN   =   'X';  { boolean value field }
  94.     fldHEXVALUE  =   'H';  { hexadecimal numeric entry }
  95.  
  96.     fldZEROMOD   =   'Z';  { zero modifier }
  97.  
  98.  
  99.   { Complex fields: }
  100.  
  101.     fldDATE      =  ' WW-'^F^Z + ^U+char(12) + ^P+char(2) +
  102.                      #0'ZW-'^Z + ^U+char(31) +
  103.                      #0'ZZZW '^Z^F + ^P+char(-6) +
  104.                      #0 + ^P+char(4);
  105.  
  106.     fldTIME      =  ' WW:'^F^Z + ^U+char(23) +
  107.                      #0'ZW '^Z + ^U+char(59) +
  108.                      #0'W'^F^H#0;  { seconds are hidden }
  109.  
  110.     fldDATETIME  =  ' WW-'^F^Z + ^U+char(12) + ^P+char(2) +
  111.                      #0'ZW-'^Z + ^U+char(31) +
  112.                      #0'ZZZW '^Z^F + ^P+char(-6) +
  113.                      '\' + ^P+char(4) +
  114.                       ' WW:'^F^Z + ^U+char(23) +
  115.                      #0'ZW:'^Z   + ^U+char(59) +
  116.                      #0'ZW '^Z^F + ^U+char(59);  { seconds are not hidden }
  117.  
  118.  
  119. type
  120.     pDMXfieldrec = ^tDMXfieldrec;
  121.     tDMXfieldrec =  RECORD    { these records describe each field for tvDMX }
  122.     Next,Prev    :  pDMXfieldrec;
  123.     access        :  byte;    { read-only, hidden, skip }
  124.     fieldnum    :  byte;    { 1..totalfields (0=none) }
  125.     screentab    :  integer;    { virtual column num. }
  126.     typecode    :  char;    { 's', 'r', etc. }
  127.     fillvalue    :  char;    { #0 or ' ' }
  128.     upperlimit    :  byte;    { maximum value limit }
  129.     showzeroes    :  boolean;    { display zero values }
  130.     truelen        :  byte;    { unformatted text length }
  131.     parenthesis    :  boolean;    { '('/')' characters }
  132.     decimals    :  byte;    { decimal point }
  133.     fieldsize    :  integer;    { sizeof (datatype) }
  134.     datatab        :  integer;    { position in record }
  135.     template    :  pstring;    { field template }
  136.     end;
  137.  
  138.  
  139.     showcodes    = (showanyway, shownegative, showregular);
  140.     showset      =  set of showcodes;    { used when displaying fields }
  141.  
  142.  
  143.   function  DmxStrLen (S : string)  : integer;
  144.     { returns the length of the visible portions of a tvDMX template string }
  145.  
  146.   function  FieldString (fieldrec  : pDMXfieldrec;
  147.              Show : showset;  var DataRec )  : string;
  148.     { returns a display string from a tvDMX field record }
  149.  
  150.  
  151. implementation
  152.  
  153.  
  154.   { ══════════════════════════════════════════════════════════════════════ }
  155.  
  156.  
  157. function  DmxStrLen (S : string)  : integer;
  158. var  i,Len,Ttl  : integer;
  159.      h          : boolean;
  160.  
  161.     procedure ResetDelimiter (D : boolean);
  162.     begin
  163.       If not h then Ttl := Ttl + Len;
  164.       If D then Inc (Ttl);
  165.       Len := 0;
  166.       h   := FALSE;
  167.     end;
  168.  
  169. begin
  170.   h   := FALSE;
  171.   Ttl := 0;
  172.   Len := 0;
  173.   i   := 0;
  174.   While (i < length (S)) do
  175.     begin
  176.     Inc (i);
  177.     Case S [i] of
  178.       '~':
  179.         begin
  180.         Inc (i);
  181.         While (S [i] <> '~') and (i < length (S)) do
  182.           begin
  183.           Inc (Len);
  184.           Inc (i);
  185.           end;
  186.         end;
  187.       ^P, ^U, ^V:  Inc (i);
  188.       ^H:          h := TRUE;
  189.       ^D:
  190.         begin
  191.         ResetDelimiter (TRUE);
  192.         Inc (i);
  193.         end;
  194.       #0,'\','|','│','║':
  195.         begin
  196.         ResetDelimiter (S [i] <> #0);
  197.         end;
  198.       ^A..^Z:  begin  end;
  199.      else      Inc (Len);
  200.       end;
  201.     end;
  202.   ResetDelimiter (FALSE);
  203.   DmxStrLen := Ttl;
  204. end;
  205.  
  206.  
  207.   { ══════════════════════════════════════════════════════════════════════ }
  208.  
  209.  
  210. function  FieldString (fieldrec    : pDMXfieldrec;
  211.                Show    : showset;  var DataRec )  : string;
  212. var  i,j,Len    :  integer;
  213.      C        :  char;
  214.      Numbers    :  boolean;
  215.      ItsBlank    :  boolean;
  216.      Q        :  boolean;
  217.      A,T    :  string;
  218.      R        :  TREALNUM;
  219.  
  220.      Data    :  pointer;
  221.      DataBool    :  pboolean  absolute Data;
  222.      DataByte    :  pbyte     absolute Data;
  223.      DataShort    :  pshortint absolute Data;
  224.      DataInt    :  pinteger  absolute Data;
  225.      DataWord    :  pword     absolute Data;
  226.      DataLong    :  plongint  absolute Data;
  227.      DataReal    :  PREALNUM  absolute Data;
  228.      DataStr    :  pstring   absolute Data;
  229.  
  230.     function  HexByte (Number : byte)  : string;
  231.     const bts  : array [0..15] of char = '0123456789ABCDEF';
  232.     begin
  233.       HexByte := bts [(Number shr 4) and $0F] + bts [Number and $0F]
  234.     end;
  235.  
  236.     function  BlankField  : boolean;
  237.     var  i : word;
  238.     begin
  239.       BlankField := TRUE;
  240.       If Len > 0 then
  241.         For i := 0 to pred (fieldrec^.fieldsize) do
  242.           If DataStr^ [i] <> #0 then BlankField := FALSE;
  243.     end;
  244.  
  245.     function  CheckBlank (Zero : boolean) :  boolean;
  246.     begin
  247.       If (Zero) and not ((fieldrec^.showzeroes) or (showanyway in Show)) then
  248.         begin
  249.         fillchar (A [1], Len, ' ');
  250.         A [0]      := chr (Len);
  251.         ItsBlank   := TRUE;
  252.         CheckBlank := TRUE;
  253.         end
  254.        else
  255.         CheckBlank := FALSE;
  256.     end;
  257.  
  258.     procedure FormNum (sign : boolean);
  259.     { length of A[] must equal Len + 1 }
  260.     var  i,j : integer;
  261.          cc  : char;
  262.     begin
  263.       With fieldrec^ do
  264.         begin
  265.         If sign and (shownegative in Show) then
  266.           begin
  267.           i := 1;
  268.           While (A [i] = ' ') do Inc (i);
  269.           If (i > 1) then A [pred (i)] := '-';
  270.           end;
  271.         If (parenthesis) then
  272.           begin
  273.           If sign then
  274.             begin
  275.             T [pos ('(', T)] := ' ';
  276.             T [pos (')', T)] := ' ';
  277.             end
  278.            else
  279.             begin
  280.             A [pos ('-', A)] := ' ';
  281.             If length (A) >